home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
32
/
cadence.zip
/
VOL2NO2.ZIP
/
GTCHANGE.LSP
< prev
next >
Wrap
Text File
|
1987-02-19
|
3KB
|
79 lines
; ================================================================
; Listing 3: Global Text Editor B. Kramer
;
; Edit text generation characteristics in graphics editor.
;
; CADENCE Tutorial Application #8
;
; Variables:
; S1 Selection set
; User User entry string
; Elist Entity list (from selection set accessing)
; New New variable data from user
;
; ================================================================
(defun c:GTCHANGE ()
(setq S1 nil) (gc) ; Clear Selection set for use.
(prompt "\nSelect text objects:")
(setq S1 (ssget))
(ss-sieve S1 "TEXT") ; Utility routine from Listing 2.
(setq User "Go")
(while (/= User "Exit")
(setq User
(strcase
(getstring "\nChange: Style/Height/Oblq angle/Rot angle/ <eXit>:")))
(if (> (strlen User) 1) (setq User (substr User 1 1)))
(cond
((and (/= User "X") (/= User ""))
(setq Code
(cond
((= User "S") 7)
((= User "H") 40)
((= User "O") 51)
((= User "R") 50)
(t nil)))
(cond
((boundp 'Code)
(setq New (getstring "\nNew value:"))
(if (> Code 20) (setq New (atof New)))
(if (and (> Code 49) (< Code 60))
(setq New (* (/ New 180.0) pi)))
(setq CNT -1)
(repeat (sslength S1)
(setq Elist (entget (ssname S1 (setq CNT (1+ CNT)))))
(entmod
(cond
((null (assoc Code Elist))
(append Elist (list (cons Code New))))
(t
(subst (cons Code New) (assoc Code Elist) Elist)
)
)
)
)
)
(t (prompt "\nEntry invalid:")))
)
(t
(setq User "Exit")))))
; ===============================================================
;
; Removes entities from selection set that are not equal to the
; entity type name passed as parameter two.
;
; (ss-sieve S1 Screen) Programming Utility Routine
;
; Variables:
; S1 Selection set
; Screen String of entity type to keep {eg: TEXT, LINE,...}
; CNT Index into selection set
; Elist Current entity list
; ===============================================================
(defun ss-sieve (S1 Screen)
(setq CNT (sslength S1))
(while (> CNT 0)
(setq Elist (entget (ssname S1 (setq CNT (1- CNT)))))
(cond
((/= (cdr (assoc 0 Elist)) Screen)
(ssdel (ssname S1 CNT) S1)))))